home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The CICA Windows Explosion!
/
The CICA Windows Explosion! - Disc 1.iso
/
desktop
/
att32all.zip
/
CHIMES.FRM
< prev
next >
Wrap
Text File
|
1994-11-16
|
13KB
|
451 lines
VERSION 2.00
Begin Form Chimes
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Double
Caption = "Chimes"
ClientHeight = 5835
ClientLeft = 3060
ClientTop = 1050
ClientWidth = 3660
ClipControls = 0 'False
ControlBox = 0 'False
Height = 6270
Left = 2985
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5835
ScaleWidth = 3660
Top = 690
Width = 3810
Begin PictureBox PlayIt
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 330
Left = 510
Picture = CHIMES.FRX:0000
ScaleHeight = 330
ScaleWidth = 360
TabIndex = 12
Top = 4530
Width = 360
End
Begin PictureBox SpeakerDown
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 330
Left = 5880
Picture = CHIMES.FRX:0182
ScaleHeight = 330
ScaleWidth = 360
TabIndex = 14
TabStop = 0 'False
Top = 1320
Width = 360
End
Begin PictureBox SpeakerUp
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 330
Left = 5880
Picture = CHIMES.FRX:0304
ScaleHeight = 330
ScaleWidth = 360
TabIndex = 15
TabStop = 0 'False
Top = 840
Width = 360
End
Begin CommonDialog CMDialog1
DefaultExt = "wav"
Filter = "Sound files (*.wav)|*.wav"
Left = 5880
Top = 240
End
Begin CommandButton Command1
Caption = "OK"
Default = -1 'True
Height = 330
Index = 0
Left = 510
TabIndex = 10
Top = 5250
Width = 1170
End
Begin CommandButton Command1
Cancel = -1 'True
Caption = "Cancel"
Height = 330
Index = 1
Left = 1950
TabIndex = 11
Top = 5250
Width = 1170
End
Begin SSCheck Chime
Caption = "Hourly"
ForeColor = &H00000000&
Height = 315
Index = 0
Left = 495
TabIndex = 0
Top = 330
Width = 825
End
Begin CommandButton Command2
Caption = " &Sound..."
Enabled = 0 'False
Height = 360
Index = 0
Left = 1950
TabIndex = 1
Top = 300
Width = 1170
End
Begin SSCheck Chime
Caption = "Multi-Ding«"
ForeColor = &H00000000&
Height = 315
Index = 4
Left = 495
TabIndex = 2
Top = 1170
Width = 1305
End
Begin CommandButton Command2
Caption = " &Sound..."
Enabled = 0 'False
Height = 360
Index = 4
Left = 1950
TabIndex = 3
Top = 1140
Width = 1170
End
Begin SSCheck Chime
Caption = "Quarter of"
ForeColor = &H00000000&
Height = 315
Index = 3
Left = 495
TabIndex = 8
Top = 3690
Width = 1230
End
Begin CommandButton Command2
Caption = " &Sound..."
Enabled = 0 'False
Height = 360
Index = 3
Left = 1950
TabIndex = 9
Top = 3660
Width = 1170
End
Begin SSCheck Chime
Caption = "Half past"
ForeColor = &H00000000&
Height = 315
Index = 2
Left = 495
TabIndex = 6
Top = 2850
Width = 1215
End
Begin CommandButton Command2
Caption = " &Sound..."
Enabled = 0 'False
Height = 360
Index = 2
Left = 1950
TabIndex = 7
Top = 2820
Width = 1170
End
Begin SSCheck Chime
Caption = "Quarter after"
ForeColor = &H00000000&
Height = 315
Index = 1
Left = 495
TabIndex = 4
Top = 2010
Width = 1395
End
Begin CommandButton Command2
Caption = " &Sound..."
Enabled = 0 'False
Height = 360
Index = 1
Left = 1950
TabIndex = 5
Top = 1980
Width = 1170
End
Begin Label CurrentSound
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label1"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 195
Left = 960
TabIndex = 20
Top = 4590
Width = 2535
WordWrap = -1 'True
End
Begin Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "L&&abel1"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 450
Index = 4
Left = 75
TabIndex = 16
Top = 1515
Width = 3030
End
Begin Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Label1"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 450
Index = 3
Left = 75
TabIndex = 17
Top = 4035
Width = 3030
End
Begin Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Label1"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 450
Index = 2
Left = 75
TabIndex = 18
Top = 3195
Width = 3030
End
Begin Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Label1"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 450
Index = 1
Left = 75
TabIndex = 19
Top = 2355
Width = 3030
End
Begin Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Label1"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 450
Index = 0
Left = 75
TabIndex = 13
Top = 675
Width = 3030
End
End
Option Explicit
Dim Playing As Integer
Sub Chime_Click (Index As Integer, Value As Integer)
Command2(Index).Enabled = Value
If Value Then
Label1(Index).ForeColor = 0
Else
Label1(Index).ForeColor = RGB(128, 128, 128)
End If
End Sub
Sub Chime_GotFocus (Index As Integer)
CurrentSound.Caption = (Label1(Index).Caption)
End Sub
Sub Command1_Click (Index As Integer)
Dim I%
If Index = 0 Then
For I% = 0 To 3
Quartering%(I%) = Chime(I%).Value
Call Chime_Click(I%, (Chime(I%).Value))
QuarterChimes$(I%) = DitchAmper$(Label1(I%).Caption)
Next I%
ChimingRelentlessly = Chime(4).Value
HourChimes$ = DitchAmper$(Label1(4).Caption)
End If
Unload Me
End Sub
Sub Command2_Click (Index As Integer)
CMDialog1.CancelError = True
On Error Resume Next
Select Case Index
Case 0
CMDialog1.DialogTitle = "Choose Hourly Sound File"
CMDialog1.Filename = QuarterChimes$(Index)
Case 1
CMDialog1.DialogTitle = "Choose Quarter-after Sound File"
CMDialog1.Filename = QuarterChimes$(Index)
Case 2
CMDialog1.DialogTitle = "Choose Half-past Sound File"
CMDialog1.Filename = QuarterChimes$(Index)
Case 3
CMDialog1.DialogTitle = "Choose Quarter-of Sound File"
CMDialog1.Filename = QuarterChimes$(Index)
Case 4
CMDialog1.DialogTitle = "Choose Multi-Ding« Sound File"
CMDialog1.Filename = HourChimes$
End Select
CMDialog1.Flags = OFN_HIDEREADONLY
CMDialog1.Action = 1
If Err = 0 Then
Select Case Index
Case 0
QuarterChimes$(Index) = CMDialog1.Filename
Case 1
QuarterChimes$(Index) = CMDialog1.Filename
Case 2
QuarterChimes$(Index) = CMDialog1.Filename
Case 3
QuarterChimes$(Index) = CMDialog1.Filename
Case 4
HourChimes$ = CMDialog1.Filename
End Select
CurrentSound.Caption = ExpandAmper$(CMDialog1.Filename)
LoadLabels
gCMDialog1Filename = CMDialog1.Filename
Call Chime_Click(Index, True)
End If
End Sub
Sub Command2_GotFocus (Index As Integer)
CurrentSound.Caption = (Label1(Index).Caption)
End Sub
Sub Command3_Click (Index As Integer)
If Index = 1 Then Unload Me
End Sub
Function DitchAmper$ (ByVal A$)
Dim I%
For I% = 1 To Len(A$) - 1
If Mid$(A$, I%, 2) = "&&" Then
A$ = Left$(A$, I%) + Mid$(A$, I% + 2, 30000)
I% = I% - 1
End If
Next I%
DitchAmper$ = A$
End Function
'
Function ExpandAmper$ (ByVal A$)
Dim I%
For I% = 1 To Len(A$)
If Mid$(A$, I%, 1) = "&" Then
A$ = Left$(A$, I%) + "&" + Mid$(A$, I% + 1, 30000)
I% = I% + 1
End If
Next I%
ExpandAmper$ = A$
End Function
Sub Form_Load ()
Dim I%
Chimes.Left = Screen.Width / 2 - (Chimes.Width / 2)
Chimes.Top = Screen.Height / 2 - (Chimes.Height / 2)
For I% = 0 To 3
Chime(I%).Value = Quartering%(I%)
Call Chime_Click(I%, (Chime(I%).Value))
Next I%
Chime(4).Value = ChimingRelentlessly
Call Chime_Click(4, (Chime(4).Value))
LoadLabels
End Sub
Sub Label1_Click (Index As Integer)
CurrentSound.Caption = Label1(Index).Caption
End Sub
Sub LoadLabels ()
Label1(0).Caption = ExpandAmper(QuarterChimes$(0))
Label1(1).Caption = ExpandAmper(QuarterChimes$(1))
Label1(2).Caption = ExpandAmper(QuarterChimes$(2))
Label1(3).Caption = ExpandAmper(QuarterChimes$(3))
Label1(4).Caption = ExpandAmper(HourChimes$)
End Sub
Sub PlayIt_Click ()
Dim x%
If Not ThereIsSOund Then Exit Sub
If SndPlaySound("", 1 + SND_NOSTOP) = 0 Then
x% = SndPlaySound("", 0)
Exit Sub
End If
Playing = True
Do While SndPlaySound(DitchAmper$(CurrentSound.Caption), 1 + SND_NOSTOP) = 0
If SoundAborted Then
x% = SndPlaySound("", 0)
Exit Do
End If
'DoEvents
Loop
Playing = False
End Sub
Sub PlayIt_MouseDown (Button As Integer, Shift As Integer, x As Single, Y As Single)
PlayIt.Picture = SPeakerDown.Picture
End Sub
Sub PlayIt_MouseUp (Button As Integer, Shift As Integer, x As Single, Y As Single)
PlayIt.Picture = SPeakerUp.Picture
End Sub
